home *** CD-ROM | disk | FTP | other *** search
- VERSION 5.00
- Begin VB.Form frmConvert
- Caption = "TurboCAD SDK file converter"
- ClientHeight = 6960
- ClientLeft = 60
- ClientTop = 345
- ClientWidth = 11415
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 6960
- ScaleWidth = 11415
- StartUpPosition = 3 'Windows Default
- Begin VB.Timer Timer1
- Enabled = 0 'False
- Interval = 500
- Left = 5040
- Top = 5760
- End
- Begin VB.ComboBox Combo2
- Height = 315
- Left = 6960
- Style = 2 'Dropdown List
- TabIndex = 18
- Top = 5280
- Width = 4215
- End
- Begin VB.ComboBox Combo1
- Height = 315
- ItemData = "frmConverter.frx":0000
- Left = 1320
- List = "frmConverter.frx":0002
- MousePointer = 1 'Arrow
- Style = 2 'Dropdown List
- TabIndex = 17
- Top = 5280
- Width = 4215
- End
- Begin VB.DriveListBox Drive2
- Height = 315
- Left = 6000
- TabIndex = 7
- Top = 1080
- Width = 2415
- End
- Begin VB.DirListBox Dir2
- Height = 2565
- Left = 6000
- TabIndex = 6
- ToolTipText = "Select a directory where converted files will be placed."
- Top = 1680
- Width = 2415
- End
- Begin VB.FileListBox File2
- Height = 2430
- Left = 8640
- Pattern = "*.tcw"
- TabIndex = 5
- Top = 1680
- Width = 2415
- End
- Begin VB.FileListBox File1
- Height = 2430
- Left = 3000
- MultiSelect = 2 'Extended
- Pattern = "*.tcw"
- TabIndex = 4
- ToolTipText = "A list of files to be converted."
- Top = 1680
- Width = 2415
- End
- Begin VB.DirListBox Dir1
- Height = 2565
- Left = 360
- TabIndex = 3
- ToolTipText = "Select a directory containing files for conversion."
- Top = 1680
- Width = 2415
- End
- Begin VB.DriveListBox Drive1
- Height = 315
- Left = 360
- TabIndex = 2
- Top = 1080
- Width = 2415
- End
- Begin VB.CommandButton Close
- Caption = "Close"
- Height = 495
- Left = 120
- TabIndex = 1
- Top = 6120
- Width = 1300
- End
- Begin VB.CommandButton Run
- Caption = "Run"
- Height = 495
- Left = 3000
- TabIndex = 0
- ToolTipText = "Starts the conversion process."
- Top = 6120
- Width = 1300
- End
- Begin VB.Frame Source
- Caption = "Source:"
- Height = 4215
- Left = 120
- TabIndex = 8
- Top = 720
- Width = 5415
- Begin VB.Label NFiles1
- Height = 375
- Left = 3960
- TabIndex = 12
- Top = 3720
- Width = 1215
- End
- Begin VB.Label Label1
- Caption = "Total files:"
- Height = 375
- Left = 2880
- TabIndex = 9
- Top = 3720
- Width = 855
- End
- End
- Begin VB.Frame Target
- Caption = "Destination:"
- Height = 4215
- Left = 5760
- TabIndex = 10
- Top = 720
- Width = 5415
- Begin VB.Label NFiles2
- Height = 375
- Left = 4080
- TabIndex = 13
- Top = 3720
- Width = 1215
- End
- Begin VB.Label Label2
- Caption = "Total files: "
- Height = 375
- Left = 2880
- TabIndex = 11
- Top = 3720
- Width = 855
- End
- End
- Begin VB.Label ExportFiltersList
- Caption = "Files of type:"
- Height = 375
- Left = 5760
- TabIndex = 16
- Top = 5280
- Width = 975
- End
- Begin VB.Label ImportFiltersList
- Caption = "Files of type:"
- Height = 375
- Left = 120
- TabIndex = 15
- Top = 5280
- Width = 975
- End
- Begin VB.Label Label3
- BorderStyle = 1 'Fixed Single
- Height = 375
- Left = 3000
- TabIndex = 14
- Top = 240
- Width = 8175
- End
- Attribute VB_Name = "frmConvert"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- '******************************************************************'
- '* *'
- '* TurboCAD for Windows *'
- '* Copyright (c) 1993 - 2001 *'
- '* International Microcomputer Software, Inc. *'
- '* (IMSI) *'
- '* All rights reserved. *'
- '* *'
- '******************************************************************'
- Option Explicit
- Private Sub Close_Click()
- Unload Me
- Set Drs = Nothing
- Set objApp = Nothing
- End Sub
- Private Sub Combo1_LostFocus()
- Timer1.Enabled = False
- File1.Pattern = Left((Right(Combo1.Text, 6)), 5)
- File1.Refresh
- NFiles1.Caption = File1.ListCount
- End Sub
- Private Sub Combo1_GotFocus()
- CurCombo = True
- Timer1.Enabled = True
- CurImportFilter = Combo1.Text
- End Sub
- Private Sub Combo2_LostFocus()
- Timer1.Enabled = False
- File2.Pattern = Left((Right(Combo2.Text, 6)), 5)
- File2.Refresh
- NFiles2.Caption = File2.ListCount
- End Sub
- Private Sub Combo2_GotFocus()
- CurCombo = False
- Timer1.Enabled = True
- CurExportFilter = Combo2.Text
- End Sub
- Private Sub Dir1_Change()
- File1.FileName = Dir1.Path
- File1.Refresh
- NFiles1.Caption = File1.ListCount
- End Sub
- Private Sub Dir2_Change()
- File2.FileName = Dir2.Path
- File2.Refresh
- NFiles2.Caption = File2.ListCount
- End Sub
- Private Sub Drive1_Change()
- Dir1.Path = Drive1.Drive
- Dir1.Refresh
- File1.FileName = Dir1.Path
- File1.Refresh
- NFiles1.Caption = File1.ListCount
- End Sub
- Private Sub Drive2_Change()
- Dir2.Path = Drive2.Drive
- Dir2.Refresh
- File2.FileName = Dir2.Path
- File2.Refresh
- NFiles2.Caption = File2.ListCount
- End Sub
- Private Sub Form_Load()
- Dim a As Integer
- Set objApp = CreateObject("IMSIGX.Application")
- If objApp Is Nothing Then
- MsgBox "Could not start server. " & Err.Description & " Quitting."
- Exit Sub
- End If
- Set Drs = objApp.Drawings
- If Drs Is Nothing Then
- MsgBox "Bad server. " & Err.Description & " Quitting"
- Exit Sub
- End If
- Call Init_FiltersList
- End Sub
- Private Sub Run_Click()
- On Error GoTo ErrorHandler
- Dim CadFile As String
- Dim CadFileSave As String
- Dim temp As String
- Dim i, b As Integer
- i = 0
- b = File1.ListCount
- If (b = 0) Then
- MsgBox "No .tcw files in source directory"
- Exit Sub
- End If
- While (i < b)
-
- Label3.Caption = File1.List(i) + " file is being converted"
- Label3.Refresh
-
- temp = Right(File1.Path, 1)
- If (temp = "\") Then
- CadFile = File1.Path & File1.List(i)
- Else
- CadFile = File1.Path & "\" & File1.List(i)
- End If
- Set Dr = Drs.Open(CadFile)
- temp = Right(File2.Path, 1)
-
- CadFileSave = Left(File1.List(i), (Len(File1.List(i)) - 4)) ' clip the extesion of the file
- If (temp = "\") Then
- CadFileSave = File2.Path & CadFileSave & Left((Right(Combo2.Text, 5)), 4)
- Else
- CadFileSave = File2.Path & "\" & CadFileSave & Left((Right(Combo2.Text, 5)), 4)
- End If
- Dr.SaveAs (CadFileSave)
- Set Dr = Nothing
- i = i + 1
- File2.Refresh
- NFiles2.Caption = File2.ListCount
- NFiles2.Refresh
- Wend
- Label3.Caption = ""
- Label3.Refresh
- MsgBox "Conversion is complete !"
- Exit Sub
- ErrorHandler:
- MsgBox Err.Description
- End Sub
- Public Sub Init_FiltersList()
- Dim n As Long
- Dim Ft As Object 'AddIn
- Dim FtName As String
- Dim i As Long
- i = 0
- Set Ftrs = objApp.Filters
- n = Ftrs.Count
- Combo1.Clear
- Combo2.Clear
- While (i < n)
- Set Ft = Ftrs.Item(i)
- FtName = Ft.FilterString
- FtName = Left(FtName, (Len(FtName) - 8))
- Combo1.AddItem FtName
- Combo2.AddItem FtName
-
- i = i + 1
- Wend
- Combo1.ListIndex = 0
- Combo2.ListIndex = 1
- File1.Pattern = Left((Right(Combo1.Text, 6)), 5)
- File1.Refresh
- NFiles1.Caption = File1.ListCount
- File2.Pattern = Left((Right(Combo2.Text, 6)), 5)
- File2.Refresh
- NFiles2.Caption = File2.ListCount
- Combo1.Refresh
- Combo2.Refresh
- End Sub
- Private Sub SetupImport_Click()
- MsgBox "Not implemented yet !"
- End Sub
- Private Sub SetupExport_Click()
- Dim CadFileSave As String
- MsgBox "Not implemented yet !"
- End Sub
- Sub Timer1_Timer()
- If (CurCombo = True) Then
- If (CurImportFilter <> Combo1.Text) Then
- File1.Pattern = Left((Right(Combo1.Text, 6)), 5)
- File1.Refresh
- NFiles1.Caption = File1.ListCount
- End If
- Else
- If (CurExportFilter <> Combo2.Text) Then
- File2.Pattern = Left((Right(Combo2.Text, 6)), 5)
- File2.Refresh
- NFiles2.Caption = File2.ListCount
- End If
- End If
- End Sub
-